;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-advanced-reader.ss" "lang")((modname client) (read-case-sensitive #f) (teachpacks ((lib "universe.ss" "teachpack" "2htdp"))) (htdp-settings #(#f constructor repeating-decimal #t #t none #f ((lib "universe.ss" "teachpack" "2htdp")))))
(require "data.scm")

;; This file implements an example client using our client-server protocol. Since this
;; was the original client we developed, it has basically been ported multiple times,
;; so the methodology behind this implementation is... interesting.

;; The client is entirely self-contained, with the exception of the data accessors. Those
;; are derived from the data.scm file, which is provided for easy use.

;; A const
(define SCREEN-WIDTH 800)
(define SCREEN-HEIGHT 600)


#|;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;|#
;;
;; @drawfunctions
;; The Draw Functions
;;;;;;;;;;;;;;;;;;;;;;

;; draw-units : Number Widget Scene -> Scene
;; draws the number of units on the given continent onto the given scene
(define (draw-units n widget sc)
  (place-image (text (number->string n) 12 'black)
               (widget-x widget)
               (widget-y widget)
               sc))
#|
(check-expect (draw-units 5 widget-canada (empty-scene 100 100))
              (place-image (text (number->string 5) 12 'black)
                           (widget-x widget-canada)
                           (widget-y widget-canada)
                           (empty-scene 100 100)))
(check-expect (draw-units 10 widget-france (empty-scene 100 100))
              (place-image (text (number->string 10) 12 'black)
                           (widget-x widget-france)
                           (widget-y widget-france)
                           (empty-scene 100 100)))|#

;; draw-widget : Widget Scene -> Scene
;; draws a widget onto a given scene
(define (draw-widget widget sc)
  (cond [(not (widget? widget)) (error 'wtf "NOT POSSIBLE")]
        [(zi? (widget-image widget))
         (place-image (widget-image widget)
                      (widget-x widget)
                      (widget-y widget)
                      sc)]
        [else
          (foldl (lambda (img rst) 
                   (place-image img
                                (widget-x widget)
                                (widget-y widget)
                                rst))
                 sc
                 (widget-image widget))]))


;; draw-territory : Territory scene → scene
;; draw a territory onto the given scene
;; also draws the number of units that the player has onto the territory
(define (draw-territory ter sc)
  (cond [(not (widget? (territory-widget ter)))
         (error 'draw-terr (symbol->string (territory-name ter)))]
        [else (draw-units (territory-units ter)
                          (territory-widget ter)
                          (draw-widget (territory-widget ter)
                                       sc))]))

(check-expect (draw-territory ter-canada (empty-scene 100 100))
              (draw-units (territory-units ter-canada)
                          (territory-widget ter-canada)
                          (draw-widget (territory-widget ter-canada)
                                    (empty-scene 100 100))))
(check-expect (draw-territory ter-france (empty-scene 100 100))
              (draw-units (territory-units ter-france)
                          (territory-widget ter-france)
                          (draw-widget (territory-widget ter-france)
                                    (empty-scene 100 100))))

;; draw-territories : [listof Territory] scene → scene
;; draws a list of territories onto a given scene
(define (draw-territories lot sc)
  (cond [(empty? lot) sc]
        [else (draw-territory (first lot)
                              (draw-territories (rest lot) sc))]))

(check-expect (draw-territories (list ter-canada ter-usa) (empty-scene 100 100))
              (draw-territory ter-canada
                              (draw-territory ter-usa
                                              (empty-scene 100 100))))

(check-expect (draw-territories (list) (empty-scene 100 100))
              (empty-scene 100 100))

;; draw-state-ui : State scene → scene
;; draws the UI applicable for the given State
;; (using a conditional)
;; @needstests **is this second test valid?
(define (draw-state-ui st sc)
  (local [(define ui-list (fourth st))]
    (draw-state-ui-assist ui-list sc)))

(check-expect (draw-state-ui g-state-p1 (empty-scene 100 100))
              (empty-scene 100 100))
;; @TODO - CHECK THIS TEST
#|(check-expect (draw-state-ui g-state-p3-o (empty-scene 100 100))
              (draw-state-ui-assist phase3-origin-buttons
                                    (empty-scene 100 100))) |#

;; draw-state-ui-assist: [listof ui-element] scene -> scene
;; draws the given ui onto the given scene.
(define (draw-state-ui-assist lou sc)
  (cond [(empty? lou) sc]
        [(button? (first lou)) (local [(define current-element (first lou))
                                       (define current-text (text (symbol->string (button-name
                                                                                    current-element))
                                                                  12
                                                                  'black))
                                       (define current-image (widget-image (button-widget current-element)))
                                       (define x (widget-x (button-widget current-element)))
                                       (define y (widget-y (button-widget current-element)))
                                       (define text-x (- x (/ (image-width current-text) 2)))
                                       (define text-y (- y (/ (image-height current-text) 2)))]
                                      (place-image
                                        current-text text-x text-y
                                        (place-image current-image x y
                                                     (draw-state-ui-assist (rest lou) sc))))]
        [else (error 'draw-state-ui-assit "An element of the ui list is not a button or dialog")]))


(check-expect (draw-state-ui-assist (list) (empty-scene 100 100))
              (empty-scene 100 100))
(check-expect (draw-state-ui-assist (fourth g-state-p3-o) (empty-scene 100 100))
              (place-image
                (text "next-phase" 12 'black)
                (- SCREEN-WIDTH 75)
                (- SCREEN-HEIGHT 50)
                (place-image
                  (rectangle 80 40 'solid 'yellow)
                  (- SCREEN-WIDTH 75)
                  (- SCREEN-HEIGHT 50)
                  (empty-scene 100 100))))

;; return-display-string : Symbol -> String
;; returns the right display string for the current state of the board.
(define (return-display-string s)
  (cond [(symbol=? s 'p1) "Place units: "]
        [(symbol=? s 'p2-origin) "Choose attacker!"]
        [(symbol=? s 'p2-victim) "Choose victim!"]
        [(symbol=? s 'p3-origin) "Choose source of move"]
        [(symbol=? s 'p3-dest) "Foritfy. Units: "]
        [else (error 'return-display-string "The current state is not a valid state")]))


;; return-display-number : State -> String
;; returns the display number if necessary for the gui string up top.
;;@needstests but it's simple
(define (return-display-number sta)
  (cond [(symbol=? (first sta) 'p1) (number->string (second sta))]
        [(symbol=? (first sta) 'p3-dest) (number->string (third sta))]
        [else ""]))

(check-expect (return-display-number g-state-p1) "10")
(check-expect (return-display-number g-state-p3-d) "0")

;; draw-world : board → scene
;; draws the current board onto a given scene
;; @performance **the tests for this method are very computationally intensive.
(define (draw-world brd)
  (if (empty? brd) (empty-scene SCREEN-WIDTH SCREEN-HEIGHT)
  (local [(define sta (board-state brd))
          (define pla (board-players brd))]
  (place-image (text (string-append (return-display-string (first sta))
                                    (return-display-number sta))
                     40 (first pla))
               200 25
               (draw-state-ui 
                (board-state brd)
                (draw-territories (board-territories brd)
                                  (empty-scene SCREEN-WIDTH SCREEN-HEIGHT)))))))

(check-expect (draw-world board-blank)
              (place-image (text "p1" 40 'blue)
                           100 100
                           (draw-territories territory-list-base
                                             (empty-scene SCREEN-WIDTH SCREEN-HEIGHT))))
(check-expect (draw-world board-blank-state2)
              (place-image (text "p2-origin" 40 'blue)
                           100 100
                           (draw-state-ui g-state-p2-o
                                          (draw-territories territory-list-base
                                                            (empty-scene SCREEN-WIDTH SCREEN-HEIGHT)))))
;;
;; END OF
;; The Draw Functions
;;;;;;;;;;;;;;;;;;;;;;

;;
;; @mousehandlerfunctions
;; Mouse Handlers
;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (contains? p e)
  (cond [(and (list? e) (= (length e) 6))
         (local [(define element-width (image-width (first (widget-image (territory-widget e)))))
                 (define element-height (image-height (first (widget-image (territory-widget e)))))
                 (define x1 (- (widget-x (territory-widget e)) (/ element-width 2)))
                 (define x2 (+ x1 element-width))
                 (define y1 (- (widget-y (territory-widget e)) (/ element-height 2)))
                 (define y2 (+ y1 element-height))]
                (and (< x1 (posn-x p))
                     (< (posn-x p) x2)
                     (< y1 (posn-y p))
                     (< (posn-y p) y2)))]
        [else ;; its a button
          (local [(define element-width (image-width (widget-image (button-widget e))))
                 (define element-height (image-height (widget-image (button-widget e))))
                 (define x1 (- (widget-x (button-widget e)) (/ element-width 2)))
                 (define x2 (+ x1 element-width))
                 (define y1 (- (widget-y (button-widget e)) (/ element-height 2)))
                 (define y2 (+ y1 element-height))]
           (and (< x1 (posn-x p))
                (< (posn-x p) x2)
                (< y1 (posn-y p))
                (< (posn-y p) y2)))]))

;; get-ui-element : Posn Board → ui-element OR #f
;; to return the UI Element containing the given posn
(define (get-ui-element p brd)
  (local [(define result (filter (lambda (x) (contains? p x))
                                 (append (board-territories brd)
                                         (cadddr (board-state brd)))))]
    (cond [(empty? result) #f]
          [else (car result)])))

;; handle-mouse-event : board mevt → board
;; handles a mouse event based on the current state of the board
(define (handle-mouse-event board x y mevt)
  (cond [(symbol=? mevt 'button-down)
         (local [(define current-ui-element
                   (get-ui-element (make-posn x y) board))]
                (cond [(boolean? current-ui-element) board]
                      [else (make-package board
                                          (list (first current-ui-element)))]))]
        [else board]))

;; Colors for continents; these are lighter colors so that the borders
;; (which represent the owner of the continents) contrast nicely. The
;; different colors represent the different continents of the board.
(define lbluey (list 'zc 'make-color 200 200 255))
(define pinky (list 'zc 'make-color 255 200 200))
(define lgreeny (list 'zc 'make-color 200 255 200))


;; assf : (X -> boolean) (listof (list X Y)) -> (list X Y) OR #f
;; Searches the given association list (key X, value Y)
;; for the first item that meets the given predicate, and returns 
;; that key-value pair. If it finds no match, it returns false.
(define (assf f list)
  (cond [(empty? list) #f]
        [(f (car (car list))) (car list)]
        [else (assf f (cdr list))]))

;; ini-tial: An association list between territory names and how to draw them.
;; this information is specific to this client. These are essentially directions
;; on how to draw the countries, which we will combine into zipped-images, and then
;; from there into actual images.
(define ini-tial (list (list 'canada        (list 'rectangle 115 95 pinky 80 70))
                       (list 'usa           (list 'rectangle 95 95 pinky 80 170))
                       (list 'mexico        (list 'rectangle 35 45 pinky 100 245))
                       (list 'sa            (list 'rectangle 65 125 pinky 95 335))
                       (list 'france        (list 'rectangle 65 65 lbluey 240 185))
                       (list 'germany       (list 'rectangle 65 45 lbluey 310 175))
                       (list 'mideast       (list 'rectangle 25 55 lbluey 290 230))
                       (list 'africa-north  (list 'rectangle 125 55 lbluey 255 310))
                       (list 'africa-south  (list 'rectangle 65 125 lbluey 265 405))
                       (list 'russia        (list 'rectangle 195 95 lgreeny 445 170))
                       (list 'china         (list 'rectangle 95 95 lgreeny 495 270))
                       (list 'australia     (list 'rectangle 95 75 lgreeny 610 380))))

;; world-parser : server-world -> zipped-world
;; converts the given world from the server into a zipped world by generating information
;; about the images that belong to the world and adding them to it.
(define (world-parser new-w) (list (cont-parser (first new-w)) 
                                   (second new-w) 
                                   (third new-w) 
                                   (state-parser (fourth new-w))))

;; cont-parser : (listof server-territory) -> (listof zipped-territory)
;; converts the given list of territories from the server into territories containing
;; zipped images. Essentially, we are using the data about the territories given to us
;; by the server to generate an expression explaining how to draw them.
;; @TODO : This needs to be made readable. Very badly.
(define (cont-parser new-c)
  (cond [(empty? new-c) new-c]
        [else   (local [(define current (first new-c))
                        (define c-name (first current))
                        (define c-assf (car (cdr (assf (lambda (x) (symbol=? x c-name)) ini-tial))))]
                  (cons (append current (list (list (fifth c-assf) (sixth c-assf)
                                              (list (list 'zi (first c-assf) (+ (second c-assf) 5) (+ (third c-assf) 5) 'solid (fifth current))
                                                    (list 'zi (first c-assf) (second c-assf) (third c-assf) 'solid (fourth c-assf))))))
                                                          (cont-parser (cdr new-c))))]))

;; state-parser : server-state -> our-state
;; appends button information to the given state list.
(define (state-parser new-s)
  (append new-s (list button-list)))

;;
;; END OF
;; Mouse Handlers
;;;;;;;;;;;;;;;;;;;;;;;;;;


;; A ZI is a (list 'zi Symbol Number Number Symbol Symbol)
;; This defines a zipped-image. The first symbol is the image whch it represents,
;; and the rest is the fileds to make the image.
  
;; Example :
(define ex-zi (list 'zi 'rectangle 30 30 'solid 'blue))

;; A Combo-Image is either:
;; - ZI
;; - (cons ZI Combo-Image)
;;   for more information regarding images see:
;;   http://docs.plt-scheme.org/teachpack/image.html

;;(define-struct widget (x y image))
;; A Widget is a:
;; (make-widget Number Number ZI)
;; Where x is the x coordinate of the center of the widget
;;       y is the y coordinate of the center of the widget
;;       image is the Combo-Image representing the shape
(define (make-widget x y image)
  (list x y image))
(define (widget-x widget)
  (first widget))
(define (widget-y widget)
  (second widget))
(define (widget-image widget)
  (third widget))
(define (widget? widget)
  (and (list? widget)
       (= (length widget) 3)))

;;(define-struct button (name widget))
;; A Button is a (make-button Symbol Widget)
;; name – text displayed on the button
;; widget - the graphical representation of the button on screen (no text)
(define (make-button name widget)
  (list name widget 'button))

(define (button-name button)
  (first button))

(define (button-widget button)
  (second button))

(define (button? button)
  (and (list? button)
       (= (length button) 3)
       (symbol=? (third button) 'button)))

;; button-name=? : Button Symbol -> Boolean
;; returns true if this is the button with name
(define (button-name=? this name)
  (and (button? this)
       (equal? (button-name this) name)))

(check-expect (button-name=? cancel 'cancel)
              true)
(check-expect (button-name=? next-phase 'next-phase)
              true)
(check-expect (button-name=? 42 'next-phase)
              false)

;; next-phase-button? : Button -> Boolean
;; returns true if this is the next phase button
(define (next-phase-button? this)
  (button-name=? this 'next-phase))

(check-expect (next-phase-button? cancel)
              false)
(check-expect (next-phase-button? next-phase)
              true)
(check-expect (next-phase-button? 42)
              false)

;; cancel-button? : Button -> Boolean
;; returns true if this is the next phase button
(define (cancel-button? this)
  (button-name=? this 'cancel))

(check-expect (cancel-button? cancel)
              true)
(check-expect (cancel-button? next-phase)
              false)
(check-expect (cancel-button? 42)
              false)

;; zi? : X -> Boolean
;; Is this thing a zipped up image, just waiting to be unleashed upon the world? (/universe?)
(define (zi? x) (cond [(not (cons? x)) false]
                      [(and (symbol? (first x))
                            (symbol=? (first x) 'zi)) true]
                      [else false]))
(check-expect (zi? (list 'zi 'blah 'blah)) true)
(check-expect (zi? 5) false)
(check-expect (zi? (list 5 4)) false)
 
;; zc? X -> Boolean
;; Is this thing a zipped up color, just waiting to brighten the scene?
(define (zc? x) (cond [(not (cons? x)) false]
                      [(and (symbol? (first x))
                            (symbol=? (first x) 'zc)) true]
                      [else false]))
(check-expect (zc? (list 'zc 45 56 60)) true)
(check-expect (zc? 4) false)
(check-expect (zc? (list 5 6)) false)
 
;; unzip-zi : ZI -> Image | #f
;; unzip me, baby! (images only)
(define (unzip-zi z) (cond [(not (zi? z)) false]
                           [(and (zi? z) (symbol=? 'rectangle (second z)))
                            (apply rectangle (cddr z))]
                           [else false]))
(check-expect (unzip-zi (list 'zi 'rectangle 100 80 'solid 'green)) (rectangle 100 80 'solid 'green))
 
;; unzip-zc : ZC -> Color | #f
;; unzip a color.
(define (unzip-zc z) (cond [(not (zc? z)) false]
                           [(and (zc? z) (symbol=? 'make-color (second z)))
                            (apply make-color (cddr z))]
                          [else false]))
 
(check-expect (unzip-zc (list 'zc 'make-color 30 40 50)) (make-color 30 40 50))


;; mega-unzip : [Listof Anythings] -> [Listof Anythings]
;; Parses through a giant list, looks for zipped up things and unzips away.
(define (mega-unzip l) (big-unzip-image (big-unzip-color l)))
 
;; big-unzip-color : [Listof Anythings] -> [Listof Anythings]
;; This function goes through and unzips the colors only (since you can't apply
;; a zipped color to a shape)
(define (big-unzip-color l)
  (cond [(not (cons? l)) l]
        [(zc? (first l)) (cons (unzip-zc (first l)) (big-unzip-color (rest l)))]
        [else (cons (big-unzip-color (first l)) (big-unzip-color (rest l)))]))
 
;; big-unzip-image : [Listof Anythings] -> [Listof Anythings]
;; This function, after the colors have been unzipped,
;; applies the image function calls.
(define (big-unzip-image l)
  (cond [(not (cons? l)) l]
        [(zi? (first l)) (cons (unzip-zi (first l)) (big-unzip-image (rest l)))]
        [else (cons (big-unzip-image (first l)) (big-unzip-image (rest l)))]))


;;
;; @buttons
;; The buttons
;;;;;;;;;;;;;;;
(define next-phase (make-button 'next-phase
                                (make-widget (- SCREEN-WIDTH 105)
                                             (- SCREEN-HEIGHT 50)
                                             (list 'zi 'rectangle 100 40 'solid 'yellow))))
(define cancel (make-button 'cancel
                            (make-widget (- SCREEN-WIDTH 190)
                                         (- SCREEN-HEIGHT 50)
                                         (list 'zi 'rectangle 80 40 'solid 'orange))))

(define button-list (list next-phase cancel))

;;
;; @bigbang
;; The Big Bang and associated functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; handle-new-msg : game sexp -> game
;; handles the receipt of a new sexp from the server.
(define (handle-new-msg game sexp)
  (mega-unzip (world-parser sexp)))

;; BIG BANG the world.
(big-bang (mega-unzip (world-parser g-board-p1))
          (register "127.0.0.1")
          (on-receive handle-new-msg)
          (on-draw draw-world)
          (on-mouse handle-mouse-event))

;;
;; END OF
;; The Big Bang and associated functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


